Čekání programu na skončení ShellExecuce

Otázka od: Lenka Donátová

23. 10. 2002 10:37

Pomocí ShellExecute spoustim pkzip.exe a potrebovala bych, aby se mi
nasledujici radky programu za timto prikazem zacaly provadet az po jeho
skonceni. Nechci pouzit Sleep protoze dopredu nevim jak dlouho bude operace
trvat. Zkousela jsem to pomoci vlaken, ale protoze jsem v tomto zacatecnik
tak se mi nepodarilo docilit toho co potrebuji. Poradte mi nekdo prosim jak
by to slo at uz pomoci vlaken nebo bez

Odpovedá: Tomáš Fajman

23. 10. 2002 12:21

  Info.cbSize := SizeOf(SHELLEXECUTEINFO);
  Info.Wnd := 0;
  Info.lpVerb := Verb;
  Info.lpFile := App;
  Info.lpParameters := Params;
  Info.lpDirectory := nil;
  Info.fMask := SEE_MASK_NOCLOSEPROCESS;
  Info.nShow := SW_SHOWNORMAL;
  ShellExecuteEx(@Info);
  if (Info.hProcess <> 0) then
    WaitForSingleObject(Info.hProcess, INFINITE);

Odpovedá: Ludek ZITA

23. 10. 2002 10:56

Odpovedá: Ludo Fulop

23. 10. 2002 12:01

----- Original Message -----
From: "Lenka Donátová" <lenkad@nemocnice-vs.cz>
> Pomocí ShellExecute spoustim pkzip.exe a potrebovala bych, aby se mi
> nasledujici radky programu za timto prikazem zacaly provadet az po jeho
> skonceni. Nechci pouzit Sleep protoze dopredu nevim jak dlouho bude
operace

Jan Sindelar - Tipy a Triky v Delphi, www.zive.cz:

Procedure ShellExecute_AndWait(FileName : String);
var
exInfo : TShellExecuteInfo;
Ph : DWORD;
begin
  FillChar( exInfo, Sizeof(exInfo), 0 );
  with exInfo do
  begin
    cbSize:= Sizeof( exInfo );
    fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
    Wnd := GetActiveWindow();
    ExInfo.lpVerb := 'open';
    lpFile:= PChar(FileName);
    nShow := SW_SHOWNORMAL;
  end;
  if ShellExecuteEx(@exInfo) then
    Ph := exInfo.HProcess;
  else
  begin
    ShowMessage(SysErrorMessage(GetLastError));
    exit;
  end;
  while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do
    Application.ProcessMessages;
  CloseHandle(Ph);
end;

Ludo Fulop

Odpovedá: Radek KALA

23. 10. 2002 12:50

Var
  si : TStartUpInfo;
  PI : TProcessInformation;
Begin
        C := 'pkzip jmeno xxx';
        P := ExtractFilePath(Application.ExeName);
        SI.dwFlags := STARTF_USESHOWWINDOW;
        SI.wShowWindow := SW_HIDE;
        CreateProcess(nil,PCHAR(C),nil,nil,FALSE, CREATE_SEPARATE_WOW_VDM or
CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE ,nil,PCHAR(P),SI,PI);
        While WaitForSingleObject(PI.hProcess,1000) = WAIT_TIMEOUT Do Begin
           Application.ProcessMessages;
        End;

> Pomocí ShellExecute spoustim pkzip.exe a potrebovala bych, aby se mi
> nasledujici radky programu za timto prikazem zacaly provadet az po
> jeho skonceni. Nechci pouzit Sleep protoze dopredu nevim jak dlouho
> bude operace trvat. Zkousela jsem to pomoci vlaken, ale protoze jsem v
> tomto zacatecnik tak se mi nepodarilo docilit toho co potrebuji.
> Poradte mi nekdo prosim jak by to slo at uz pomoci vlaken nebo bez
>

                     S pozdravem Radek KALA
                     BetaControl, s.r.o.
                     Cerneho 58/60, 635 00
                     tlf. : + 420 5 4622 3491
                     fax : + 420 5 4622 3470
                     GSM : + 420 603 85 75 15

Odpovedá: Roman Macura

23. 10. 2002 12:26

Tohle funguje na Win95/98/ME/2000. Na WinXP jsem to nezkoušel.

{---------------------------------------------------------------------------
--
* This unit is based upon the well-known *
* and largely used WinExecAndWait function*
* The former WinexecAndWait function *
*
doesn't compile under Delphi 2.0 *
* because the GetModuleUsage function is *
* no longer supported under Win95. *
* I have simply updated the previous code *
* so that it works with Delphi 2.0 under *
* Windows 95. With this function you can *
* call Windows-based applications as well *
* as Dos-based commands. *
* That is 'c:\myapp\app32.exe' as well as *
* 'command.com
/c del
*.bak'. * *
* USAGE: *
* *
* err:=WinExecAndWait32( *
* Full FileName & *
* command-line parameters, *
* SW_HIDE/SW_SHOW, *
* 0 or output file handle); *
* if err<>0 then *
* showmessage('Error!'); *
* *
----------------------------------------------------------------------------
-}
unit WinExc32;
interface
uses windows, messages;
function WinExecAndWait32(Path: PChar; Visibility:
Word;OutTo:integer;Directory:PChar=nil): integer;
function WinExec32(Path: PChar; Visibility: Word;OutTo:integer): integer;
function WinExecAndWait32WithExitCode(Path: PChar; Visibility:
Word;OutTo:integer;var ExitCode:Cardinal;Directory:PChar=nil): integer;
implementation
function WinExecAndWait32(Path: PChar; Visibility:
Word;OutTo:Integer;Directory:PChar=nil): integer;
var
Msg: TMsg;
lpExitCode : Cardinal;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
InhHndls:Boolean;
begin
FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
with StartupInfo do
  begin
   InhHndls:=False;
   cb := SizeOf(TStartupInfo);
   dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
   if OutTo<>0 then
    begin
     dwFlags:=dwFlags or STARTF_USESTDHANDLES;
     InhHndls:=True;
     hStdInput:=0;
     hStdError:=0;
     hStdOutput:=OutTo;
    end;
   wShowWindow := visibility; {you could pass sw_show or sw_hide as
parameter}
  end;
if CreateProcess(nil, path, nil, nil, InhHndls,
   NORMAL_PRIORITY_CLASS, nil, Directory, StartupInfo, ProcessInfo) then
  begin
   repeat
    while PeekMessage(Msg, 0, 0, 0, pm_Remove) do
     begin
      if Msg.Message = wm_Quit then Halt(Msg.WParam);
      TranslateMessage(Msg);
      DispatchMessage(Msg);
     end;
    GetExitCodeProcess(ProcessInfo.hProcess,lpExitCode);
   until lpExitCode<>Still_Active;
   with ProcessInfo do {not sure this is necessary but seen in in some code
elsewhere}
    begin
     CloseHandle(hThread);
     CloseHandle(hProcess);
    end;
   result := 0; {sucess}
  end
else
  result:=GetLastError;{error occurs during CreateProcess see help for
details}
end;
function WinExec32(Path: PChar; Visibility: Word;OutTo:integer): integer;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
InhHndls:boolean;
begin
FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
with StartupInfo do
  begin
   InhHndls:=false;
   cb := SizeOf(TStartupInfo);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
      if OutTo<>0 then
       begin
         dwFlags:=dwFlags or STARTF_USESTDHANDLES;
          InhHndls:=true;
          hStdOutput:=OutTo;
        end;
     wShowWindow := visibility; {you could pass sw_show or sw_hide as
parameter}
    end;
  if CreateProcess(nil,path,nil, nil, InhHndls,
     NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then
    result := 0 {sucess}
  else
    result:=GetLastError;{error occurs during CreateProcess see help for
details}
end;
function WinExecAndWait32WithExitCode(Path: PChar; Visibility:
Word;OutTo:integer;var ExitCode:Cardinal;Directory:PChar=nil): integer;
var
Msg: TMsg;
outto2,lpExitCode : cardinal;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
InhHndls:boolean;
SA:Security_Attributes;
VerInfo: TOSVersionInfo;
cont:Boolean;
begin
outto2:=0;
ExitCode:=0;
FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
with StartupInfo do
  begin
   InhHndls:=false;
   cb := SizeOf(TStartupInfo);
   dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
   if OutTo<>0 then
    begin
     dwFlags:=dwFlags or STARTF_USESTDHANDLES;
     InhHndls:=true;
     hStdInput:=0;
     hStdError:=0;
     hStdOutput:=OutTo;
    end;
   wShowWindow := visibility; {you could pass sw_show or sw_hide as
parameter}
  end;
VerInfo.dwOSVersionInfoSize:=sizeof(TOSVERSIONINFO);
GetVersionEx(VerInfo);
if VerInfo.dwPlatformId in [VER_PLATFORM_WIN32_NT] then
begin
  SA.nLength:=SizeOf(PSECURITYATTRIBUTES);
  SA.bInheritHandle:=inhhndls;
  SA.lpSecurityDescriptor:=nil;
  if inhhndls then
  begin
DuplicateHandle(GetCurrentProcess,outto,GetCurrentProcess,@outto2,0,True,DUP
LICATE_SAME_ACCESS);
   Startupinfo.hStdOutput:=outto2;
  end;
  cont:=CreateProcess(nil, path, @sa, nil, InhHndls,
   NORMAL_PRIORITY_CLASS, nil, Directory, StartupInfo, ProcessInfo);
end
else
  cont:=CreateProcess(nil, path, nil, nil, InhHndls,
   NORMAL_PRIORITY_CLASS, nil, Directory, StartupInfo, ProcessInfo);
if cont then
begin
  repeat
   while PeekMessage(Msg, 0, 0, 0, pm_Remove) do
    begin
     if Msg.Message = wm_Quit then Halt(Msg.WParam);
     TranslateMessage(Msg);
     DispatchMessage(Msg);
    end;
   GetExitCodeProcess(ProcessInfo.hProcess,lpExitCode);
  until lpExitCode<>Still_Active;
  ExitCode:=lpExitCode;
  with ProcessInfo do {not sure this is necessary but seen in in some code
elsewhere}
   begin
    if outto2<>0 then
     CloseHandle(outto2);
    CloseHandle(hThread);
    CloseHandle(hProcess);
   end;
  result := 0; {sucess}
end
else
  result:=GetLastError;{error occurs during CreateProcess see help for
details}
end;
end.
Roman.
----- Original Message -----
From: "Lenka Donátová" <lenkad@nemocnice-vs.cz>
To: <delphi-l@clexpert.cz>
Sent: Wednesday, October 23, 2002 11:38 AM
Subject: Čekání programu na skončení ShellExecuce

> Pomocí ShellExecute spoustim pkzip.exe a potrebovala bych, aby se mi
> nasledujici radky programu za timto prikazem zacaly provadet az po jeho
> skonceni. Nechci pouzit Sleep protoze dopredu nevim jak dlouho bude
operace
> trvat. Zkousela jsem to pomoci vlaken, ale protoze jsem v tomto zacatecnik
> tak se mi nepodarilo docilit toho co potrebuji. Poradte mi nekdo prosim
jak
> by to slo at uz pomoci vlaken nebo bez
>
>

Odpovedá: Vymazal Milan

23. 10. 2002 15:36

Ja pouzivam tohle

function WinExecAndWait32(FileName:String; Visibility : integer):integer;
var
  zAppName:array[0..512] of char;
  zCurDir:array[0..255] of char;
  WorkDir:String;
  StartupInfo:TStartupInfo;
  ProcessInfo:TProcessInformation;
begin
  StrPCopy(zAppName,FileName);
  GetDir(0,WorkDir);
  StrPCopy(zCurDir,WorkDir);
  FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  StartupInfo.cb := Sizeof(StartupInfo);

  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  if not CreateProcess(nil,
    zAppName, { pointer to command line string }
    nil, { pointer to process security attributes }
    nil, { pointer to thread security attributes }
    false, { handle inheritance flag }
    CREATE_NEW_CONSOLE or { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil, { pointer to new environment block }
    nil, { pointer to current directory name }
    StartupInfo, { pointer to STARTUPINFO }
    ProcessInfo) then Result := -1 { pointer to PROCESS_INF }

  else begin
    WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess,Result);
  end;
end;